{- This file is part of vcs-web-hook-parse.
 -
 - Written in 2015, 2017 by fr33domlover <fr33domlover@riseup.net>.
 -
 - ♡ Copying is an act of love. Please copy, reuse and share.
 -
 - The author(s) have dedicated all copyright and related and neighboring
 - rights to this software to the public domain worldwide. This software is
 - distributed without any warranty.
 -
 - You should have received a copy of the CC0 Public Domain Dedication along
 - with this software. If not, see
 - <http://creativecommons.org/publicdomain/zero/1.0/>.
 -}

{-# LANGUAGE OverloadedStrings #-}

-- | Gogs web hook types and parser. Development of this module so far
-- specifically tracks the Gogs instance and version running at
-- <https://notabug.org>.
module Web.Hook.Gogs
    ( CommitID
    , Url
    , User (..)
    , User' (..)
    , Commit (..)
    , Repository (..)
    , Push (..)
    , MergeRequest (..)
    , IssueState (..)
    , Issue (..)
    , IssueAction (..)
    , IssueChange (..)
    , IssueEvent (..)
    , Comment (..)
    , CommentAction (..)
    , IssueComment (..)
    , Event (..)
    , parse
    )
where

import Attoparsec.Time (utcTimeInISO8601)
import Control.Applicative
import Control.Monad (mzero)
import Data.Aeson
import Data.Text (Text)
import Data.Time.Clock (UTCTime)

import qualified Data.Attoparsec.Text as A
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as B
import qualified Data.Text as T

import Web.Hook.Util

data Iso8601 = Iso8601 { fromIso8601 :: UTCTime }

instance FromJSON Iso8601 where
    parseJSON v = do
        s <- parseJSON v
        case A.parseOnly (utcTimeInISO8601 <* A.endOfInput) s of
            Left _  -> mzero
            Right t -> return $ Iso8601 t

type CommitID = Text

type Url = Text

data User = User
    { userName     :: Text
    , userEmail    :: Text
    , userUsername :: Text
    }
    deriving Show

data User' = User'
    { userId'       :: Int
    , userLogin'    :: Text
    , userFullName' :: Text
    , userEmail'    :: Text
    , userAvatar'   :: Url
    , userUsername' :: Text
    }
    deriving Show

data Commit = Commit
    { commitId      :: CommitID
    , commitMessage :: Text
    , commitUrl     :: Url
    , commitAuthor  :: User
    }
    deriving Show

data Repository = Repository
    { repoId          :: Int
    , repoOwner       :: User'
    , repoName        :: Text
    , repoFullName    :: Text
    , repoDescription :: Text
    , repoPrivate     :: Bool
    , repoFork        :: Bool
    , repoMirror      :: Bool
    , repoHomeUrl     :: Url
    , repoCloneUrl    :: Url
    , repoSshUrl      :: Url
    , repoWebsite     :: Url
    , repoStars       :: Int
    , repoForks       :: Int
    , repoWatchers    :: Int
    , repoOpenIssues  :: Int
    , repoDefBranch   :: Text
    , repoCreatedAt   :: UTCTime
    , repoUpdatedAt   :: UTCTime
    }
    deriving Show

data Push = Push
    { pushSecret     :: Text
    , pushRef        :: Text
    , pushCommits    :: [Commit]
    , pushRepository :: Repository
    , pushPusher     :: User'
    , pushBefore     :: CommitID
    , pushAfter      :: CommitID
    , pushCompareUrl :: Url
    }
    deriving Show

data MergeRequest = MergeRequest
    { mrMerged   :: Bool
    , mrMergedAt :: UTCTime
    }
    deriving Show

data IssueState = ISOpen | ISClosed deriving Show

data Issue = Issue
    { issueId           :: Int
    , issueNumber       :: Int
    , issueUser         :: User'
    , issueTitle        :: Text
    , issueBody         :: Text
    , issueLabels       :: [Text]
    , issueMilestone    :: Maybe ()
    , issueAssignee     :: Maybe ()
    , issueState        :: IssueState
    , issueComments     :: Int
    , issueCreatedAt    :: UTCTime
    , issueUpdatedAt    :: UTCTime
    , issueMergeRequest :: Maybe MergeRequest
    }
    deriving Show

data IssueAction = IssueOpen | IssueEdit | IssueLabelUpdate | IssueClose
    deriving Show

data IssueChange = IssueChangeTitle Text deriving Show

data IssueEvent = IssueEvent
    { ieAction     :: IssueAction
    , ieNumber     :: Int
    , ieIssue      :: Issue
    , ieChanges    :: Maybe IssueChange
    , ieRepository :: Repository
    , ieSender     :: User'
    }
    deriving Show

data Comment = Comment
    { commentId        :: Int
    , commentUrl       :: Text
    , commentUser      :: User'
    , commentBody      :: Text
    , commentCreatedAt :: UTCTime
    , commentUpdatedAt :: UTCTime
    }
    deriving Show

data CommentAction = CommentCreated deriving Show

data IssueComment = IssueComment
    { icAction     :: CommentAction
    , icIssue      :: Issue
    , icComment    :: Comment
    , icRepository :: Repository
    , icSender     :: User'
    }
    deriving Show

data Event
    = EventPush Push
    | EventIssue IssueEvent
    | EventIssueComment IssueComment
    deriving Show

instance FromJSON User where
    parseJSON (Object v) =
        User <$>
        (v .: "name" <|> v .: "full_name") <*>
        v .: "email" <*>
        v .: "username"
    parseJSON _          = mzero

instance FromJSON User' where
    parseJSON (Object v) =
        User' <$>
        v .: "id"         <*>
        v .: "login"      <*>
        v .: "full_name"  <*>
        v .: "email"      <*>
        v .: "avatar_url" <*>
        v .: "username"
    parseJSON _          = mzero

instance FromJSON Commit where
    parseJSON (Object v) =
        Commit <$>
        v .: "id" <*>
        v .: "message" <*>
        v .: "url" <*>
        v .: "author"
    parseJSON _          = mzero

instance FromJSON Repository where
    parseJSON (Object v) =
        Repository <$>
        v .: "id" <*>
        v .: "owner" <*>
        v .: "name" <*>
        v .: "full_name" <*>
        v .: "description" <*>
        v .: "private" <*>
        v .: "fork" <*>
        v .: "mirror" <*>
        v .: "html_url" <*>
        v .: "ssh_url" <*>
        v .: "clone_url" <*>
        v .: "website" <*>
        v .: "stars_count" <*>
        v .: "forks_count" <*>
        v .: "watchers_count" <*>
        v .: "open_issues_count" <*>
        v .: "default_branch" <*>
        (fromIso8601 <$> v .: "created_at") <*>
        (fromIso8601 <$> v .: "updated_at")
    parseJSON _          = mzero

instance FromJSON Push where
    parseJSON (Object v) =
        Push <$>
        v .:? "secret" .!= "" <*>
        v .: "ref" <*>
        v .: "commits" <*>
        v .: "repository" <*>
        v .: "pusher" <*>
        v .: "before" <*>
        v .: "after" <*>
        v .: "compare_url"
    parseJSON _          = mzero

instance FromJSON MergeRequest where
    parseJSON (Object v) =
        MergeRequest <$>
        v .: "merged" <*>
        (fromIso8601 <$> v .: "merged_at")
    parseJSON _          = mzero

instance FromJSON IssueState where
    parseJSON v =
        let p = parseJSON v
        in  ISOpen   <$ text p "open"   <|>
            ISClosed <$ text p "closed" <|>
            fail "Unrecognized issue state"

instance FromJSON Issue where
    parseJSON (Object v) =
        Issue <$>
        v .: "id" <*>
        v .: "number" <*>
        v .: "user" <*>
        v .: "title" <*>
        v .: "body" <*>
        pure [] <*> -- v .: "labels" <*>
        pure Nothing <*> -- v .: "milestone" <*>
        pure Nothing <*> -- v .: "assignee" <*>
        v .: "state" <*>
        v .: "comments" <*>
        (fromIso8601 <$> v .: "created_at") <*>
        (fromIso8601 <$> v .: "updated_at") <*>
        v .: "pull_request"
    parseJSON _          = mzero

instance FromJSON IssueAction where
    parseJSON v =
        let p = parseJSON v
        in  IssueOpen        <$ text p "opened"        <|>
            IssueEdit        <$ text p "edited"        <|>
            IssueLabelUpdate <$ text p "label_updated" <|>
            IssueLabelUpdate <$ text p "closed"        <|>
            fail "Unrecognized issue action"

instance FromJSON IssueChange where
    parseJSON (Object v) = IssueChangeTitle <$> v .: "title"
    parseJSON _          = mzero

instance FromJSON IssueEvent where
    parseJSON (Object v) =
        IssueEvent <$>
        v .: "action"     <*>
        v .: "number"     <*>
        v .: "issue"      <*>
        v .:? "changes"   <*>
        v .: "repository" <*>
        v .: "sender"
    parseJSON _          = mzero

instance FromJSON Comment where
    parseJSON (Object v) =
        Comment <$>
        v .: "id" <*>
        v .: "html_url" <*>
        v .: "user" <*>
        v .: "body" <*>
        (fromIso8601 <$> v .: "created_at") <*>
        (fromIso8601 <$> v .: "updated_at")
    parseJSON _          = mzero

instance FromJSON CommentAction where
    parseJSON v =
        let p = parseJSON v
        in  CommentCreated <$ text p "created"

instance FromJSON IssueComment where
    parseJSON (Object v) =
        IssueComment <$>
        v .: "action"     <*>
        v .: "issue"      <*>
        v .: "comment"    <*>
        v .: "repository" <*>
        v .: "sender"
    parseJSON _          = mzero

-- | Parse a JSON string (the body of the HTTP request) into event information.
-- If parsing fails, return 'Left' an error message.
parsePush :: B.ByteString -> Either String Push
parsePush = eitherDecode

parseIssue :: B.ByteString -> Either String IssueEvent
parseIssue = eitherDecode

parseIssueComment :: B.ByteString -> Either String IssueComment
parseIssueComment = eitherDecode

parse :: BS.ByteString -> B.ByteString -> Either String Event
parse event body =
    case event of
        "push"          -> EventPush         <$> parsePush body
        "issues"        -> EventIssue        <$> parseIssue body
        "issue_comment" -> EventIssueComment <$> parseIssueComment body
        _               -> Left "Unrecognized Gogs event"
